home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / ExeType.cls < prev    next >
Text File  |  1997-06-14  |  6KB  |  188 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "GExeType"
  6. Attribute VB_GlobalNameSpace = True
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Public Enum EErrorExeType
  13.     eeBaseExeType = 13470   ' ExeType
  14. End Enum
  15.  
  16. ' Valid Exe types (for ExeType function)
  17.  
  18. Public Enum EProgramType
  19.     ' Unknown - could still be .BAT, .CMD, .COM, or .PIF
  20.     eptNotExe = 0
  21.     ' Recognized executable types
  22.     eptMSDOS = 1
  23.     eptWin16 = 2
  24.     eptOS2_1 = 3
  25.     eptWin32 = 4
  26.     eptWin32Console = 5
  27.     eptDOSUnknown = 7
  28.     ' Errors
  29.     eptNoFile = -1
  30.     eptOS2_2 = -2
  31.     eptWinOS2DLL = -3
  32.     eptNEUnknown = -4
  33.     eptNTNonIntel = -5
  34.     eptWin32DLL = -6
  35.     eptAccessFail = -7
  36. End Enum
  37.  
  38. ' Check to see if specified file is executable, and if so, what kind
  39. Function ExeType(sSpec As String) As EProgramType
  40.     On Error GoTo ExeTypeFail
  41.     Dim hFile As Integer
  42.     hFile = FreeFile
  43.     If MUtility.ExistFile(sSpec) Then
  44.         Open sSpec For Binary Access Read Shared As hFile
  45.     Else
  46.         ExeType = eptNoFile
  47.         Exit Function
  48.     End If
  49.  
  50.     Dim abHeader() As Byte
  51.     ReDim abHeader(128)
  52.     Get hFile, 1, abHeader
  53.  
  54.     ' MS-DOS headers start with magic header "MZ"
  55.     Dim sMagic As String, bData As Byte, wData As Integer
  56.     sMagic = MBytes.LeftBytes(abHeader, 2)
  57.     If sMagic <> "MZ" Then
  58.         ' Could still be a .BAT, .CMD, .PIF, or .COM file
  59.         ExeType = eptNotExe
  60.         Close hFile
  61.         Exit Function
  62.     End If
  63.  
  64.     ' If word at offset &H18 does not point beyond DOS header
  65.     ' (length &H40), file is MS-DOS EXE
  66.     If MBytes.BytesToWord(abHeader, &H18) < &H40 Then
  67.         ExeType = eptMSDOS
  68.         Close hFile
  69.         Exit Function
  70.     End If
  71.  
  72.     ' Get offset of new EXE header
  73.     wData = MBytes.BytesToWord(abHeader, &H3C)
  74.     Get hFile, wData + 1, abHeader
  75.     Close hFile
  76.  
  77.     ' New .EXE headers start with magic header "NE"
  78.     sMagic = MBytes.LeftBytes(abHeader, 2)
  79.     ' Check for Windows/OS2 format
  80.     If sMagic = "NE" Then
  81.  
  82.         ' Get the executable file flags to check for DLL
  83.         If abHeader(&HD) And &H80 Then
  84.             ' This is a DLL (executable but not by us)
  85.             ExeType = eptWinOS2DLL
  86.         Else
  87.             ' Get the operating system flags (byte, not word)
  88.             bData = abHeader(&H36)
  89.             If bData And &H2 Then
  90.                 ExeType = eptWin16 ' Windows
  91.             ElseIf bData And &H1 Then
  92.                 ExeType = eptOS2_1 ' OS/2 1.x
  93.             Else
  94.                 ' Unknown NE system, probably bound, but call it MS-DOS
  95.                 ExeType = eptMSDOS
  96.             End If
  97.         End If
  98.  
  99.     ' Check for OS/2 2.x format (can't execute from Windows or NT)
  100.     ElseIf sMagic = "LE" Then
  101.         ExeType = eptOS2_2 ' OS/2 LE
  102.     ' Check for NT format
  103.     ElseIf sMagic = "PE" And MBytes.BytesToWord(abHeader, &H2) = 0 Then
  104.         ' Get processor flags
  105.         bData = abHeader(&H4)
  106.         Select Case bData
  107.         Case &H4C, &H4D, &H4E, &H4F ' NT for intel 386, 486, 586, 686
  108.             ExeType = eptWin32 ' NT Windows
  109.         Case Else
  110.             ExeType = eptNTNonIntel ' Some sort of RISC or other
  111.             Exit Function
  112.         End Select
  113.  
  114.         ' Get the Exe type flags
  115.         If abHeader(&H17) And &H20 Then
  116.             ExeType = eptWin32DLL ' Executable, but not by us
  117.             Exit Function
  118.         End If
  119.  
  120.         ' Get the subsystem flags to identify NT character
  121.         If abHeader(&H5C) = 3 Then ExeType = eptWin32Console
  122.         ' Could also identify Posix here
  123.  
  124.     Else
  125.         ' MS-DOS file with a header, but notNE file
  126.         ' (Some 16-bit DOS-extended executables fall through here, or
  127.         ' could be non-EXE file with "MZ" as first two bytes)
  128.         ExeType = eptDOSUnknown ' Probably DOS extended
  129.     End If
  130.     Exit Function
  131.     
  132. ExeTypeFail:
  133.     ExeType = eptAccessFail
  134. End Function
  135.  
  136. Function ExeTypeStr(sFile As String) As String
  137.     Select Case ExeType(sFile)
  138.     ' Valid Exe types (for ExeType function)
  139.     Case eptMSDOS
  140.         ExeTypeStr = "MS-DOS"
  141.     Case eptWin16
  142.         ExeTypeStr = "Windows 16-bit"
  143.     Case eptOS2_1
  144.         ExeTypeStr = "OS/2 1.x"
  145.     Case eptWin32
  146.         ExeTypeStr = "Windows 32-bit"
  147.     Case eptWin32Console
  148.         ExeTypeStr = "Windows 32-bit Console"
  149.     Case eptDOSUnknown
  150.         ExeTypeStr = "Unknown MS-DOS Compatible"
  151.     Case eptNotExe
  152.         ExeTypeStr = "Not EXE File"
  153.     Case eptNoFile
  154.         ExeTypeStr = "No File"
  155.     Case eptOS2_2
  156.         ExeTypeStr = "OS/2 2.x"
  157.     Case eptWinOS2DLL
  158.         ExeTypeStr = "Windows 3.x or OS/2 DLL"
  159.     Case eptNEUnknown
  160.         ExeTypeStr = "Unknown Format"
  161.     Case eptNTNonIntel
  162.         ExeTypeStr = "Non-Intel Windows"
  163.     Case eptWin32DLL
  164.         ExeTypeStr = "Windows 32-bit DLL"
  165.     End Select
  166. End Function
  167.  
  168. #If fComponent = 0 Then
  169. Private Sub ErrRaise(e As Long)
  170.     Dim sText As String, sSource As String
  171.     If e > 1000 Then
  172.         sSource = App.ExeName & ".ExeType"
  173.         Select Case e
  174.         Case eeBaseExeType
  175.             BugAssert True
  176.        ' Case ee...
  177.        '     Add additional errors
  178.         End Select
  179.         Err.Raise COMError(e), sSource, sText
  180.     Else
  181.         ' Raise standard Visual Basic error
  182.         sSource = App.ExeName & ".VBError"
  183.         Err.Raise e, sSource
  184.     End If
  185. End Sub
  186. #End If
  187.  
  188.